unit text; {This unit contains routines for opening, saving, scrolling and editing text windows.} interface uses QuickDraw, Palettes, PictUtil, PrintTraps, globals, Utilities, Graphics, File2; procedure UpdateScrollBars; procedure UpdateTextWindow (WhichWindow: WindowPtr); procedure ActivateTextWindow (WhichWindow: WindowPtr; Activating: boolean); procedure DoMouseDownInText (event: EventRecord; WhichWindow: WindowPtr); procedure ScrollText; procedure GrowTextWindow (NewSize: LongInt); function MakeNewTextWindow (name: str255; width, height: integer): boolean; function OpenTextFile (name: str255; RefNum: integer): boolean; procedure DoKeyDownInText (ch: char); procedure ChangeFontOrSize; procedure DoTextCopy; procedure DoTextPaste; procedure DoTextClear; procedure SaveText; procedure SaveTextAs; function SaveTextChanges: integer; procedure InsertText (str: str255; EndOfLine: boolean); procedure DoFind; procedure DecrementTextWindowNums (num: integer); implementation type CharArrayType = packed array[0..32767] of char; CharArrayPtr = ^CharArrayType; procedure UpdateScrollBars; var vMax, vValue, hMax, hValue: integer; begin with TextInfo^ do begin hlock(handle(TextTE)); with TextTE^^, TextTE^^.viewRect do begin vTextPageSize := (bottom - top) div LineHeight; hTextPageSize := right - left; vMax := nLines - vTextPageSize; hMax := 0; vValue := (top - destRect.top) div LineHeight; hValue := left - destRect.left; if vMax < 0 then vMax := 0; if vValue < 0 then vValue := 0; if hMax < 0 then hMax := 0; if vValue < 0 then vValue := 0; SetCtlMax(vTextScrollBar, vMax); SetCtlValue(vTextScrollBar, vValue); SetCtlMax(hTextScrollBar, hMax); SetCtlValue(hTextScrollBar, hValue); end; hunlock(handle(TextTE)); end; {ShowMessage(concat('nListColumns= ', Long2str(nListColumns), cr, 'hListPageSize= ', long2str(hListPageSize)));} end; procedure SetTextInfo; {Updates TextInfo so it points to the active text window.} var kind: integer; begin kind := CurrentWindow; end; procedure UpdateTextWindow (WhichWindow: WindowPtr); begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo <> nil then with TextInfo^ do begin SetPort(TextWindowPtr); DrawControls(TextWindowPtr); DrawGrowIcon(TextWindowPtr); EraseRect(TextTE^^.viewRect); TEUpdate(TextTE^^.viewRect, TextTE); UpdateScrollBars; end; {with} SetTextInfo; end; procedure ActivateTextWindow (WhichWindow: WindowPtr; Activating: boolean); begin if Activating then UpdateTextWindow(WhichWindow); TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo <> nil then with TextInfo^ do if Activating then begin TEActivate(TextTE); ShowControl(hTextScrollBar); ShowControl(vTextScrollBar); WhatToUndo := NothingToUndo; end else begin TEDeactivate(TextTE); HideControl(hTextScrollBar); HideControl(vTextScrollBar); end; SetTextInfo; end; procedure SetFontSize; var fInfo: FontInfo; begin with TextInfo^ do begin SetPort(TextWindowPtr); TextFont(CurrentFontID); TextSize(CurrentSize); with TextTE^^, fInfo do begin GetFontInfo(fInfo); TxSize := CurrentSize; LineHeight := ascent + descent + leading; FontAscent := ascent; end; end; end; procedure InitTextEdit; var dRect, vRect: rect; begin with TextInfo^ do begin SetPort(TextWindowPtr); SetRect(vrect, 0, 0, TextWidth - ScrollBarWidth, TextHeight - ScrollBarWidth); drect := vrect; InsetRect(drect, 4, 4); TextTE := TENew(drect, vrect); with TextTE^^ do begin TxFont := CurrentFontID; SetFontSize; crOnly := 1; {do word wrap} end; TESetSelect(0, 0, TextTE); UpdateScrollBars; TEAutoView(true, TextTE); {Enable auto-scrolling} end; end; procedure ScrollText; var value: integer; begin with TextInfo^, TextInfo^.TextTE^^ do TEScroll(0, (viewRect.top - destRect.top) - (GetCtlValue(vTextScrollBar) * LineHeight), TextTE); end; procedure ScrAction (theCtl: ControlHandle; partCode: integer); var bInc, pInc, delta: integer; begin if TextInfo <> nil then with TextInfo^ do begin if theCtl = vTextScrollBar then begin bInc := 1; pInc := vTextPageSize end else begin bInc := 4; pInc := hTextPageSize end; case partCode of inUpButton: delta := -bInc; inDownButton: delta := bInc; inPageUp: delta := -pInc; inPageDown: delta := pInc; otherwise exit(ScrAction); end; SetCtlValue(theCtl, GetCtlValue(theCtl) + delta); ScrollText; end; {with} end; procedure DoMouseDownInText (event: EventRecord; WhichWindow: WindowPtr); var theCtl: ControlHandle; cValue: integer; loc: point; begin TextInfo := TextInfoPtr(WindowPeek(WhichWindow)^.RefCon); if TextInfo = nil then exit(DoMouseDownInText); SelectWindow(WhichWindow); SetPort(WhichWindow); loc := event.where; GlobalToLocal(loc); with TextInfo^ do if PtInRect(loc, TextTE^^.viewRect) then begin TEClick(loc, BitTst(@event.modifiers, 6), TextTE); UpdateScrollBars; end else case FindControl(loc, WhichWindow, theCtl) of inUpButton, inDownButton, inPageUp, inPageDown: if TrackControl(theCtl, loc, @ScrAction) <> 0 then ; inThumb: if TrackControl(theCtl, loc, nil) <> 0 then ScrollText; otherwise end; end; procedure GrowTextWindow (NewSize: LongInt); begin if TextInfo <> nil then with TextInfo^ do begin TextWidth := LoWord(NewSize); TextHeight := hiWord(NewSize); SetPort(TextWindowPtr); SizeWindow(TextWindowPtr, TextWidth, TextHeight, true); EraseRect(TextWindowPtr^.PortRect); MoveControl(hTextScrollBar, -1, TextHeight - ScrollBarWidth); MoveControl(vTextScrollBar, TextWidth - ScrollBarWidth, -1); SizeControl(hTextScrollBar, TextWidth - 13, ScrollBarWidth + 1); SizeControl(vTextScrollBar, ScrollBarWidth + 1, TextHeight - 13); InvalRect(TextWindowPtr^.PortRect); with TextTE^^ do begin SetRect(viewRect, 0, 0, TextWidth - ScrollBarWidth, TextHeight - ScrollBarWidth); viewRect.bottom := (viewRect.bottom div lineHeight) * lineHeight; destRect := viewRect; InsetRect(destRect, 4, 4); end; TECalText(TextTE); ScrollText; end; {with} end; function MakeNewTextWindow (name: str255; width, height: integer): boolean; var wrect, crect: rect; begin MakeNewTextWindow := false; if nTextWindows >= 10 then begin PutMessage(concat('NIH Image cannot open more than ', long2str(MaxTextWindows), ' text windows.')); exit(MakeNewTextWindow); end; TextInfo := TextInfoPtr(NewPtr(SizeOf(TextInfoRec))); if TextInfo = nil then exit(MakeNewTextWindow); with TextInfo^ do begin TextWidth := width; TextHeight := height; TextLeft := PicLeft; TextTop := PicTop; PicLeft := PicLeft + hPicOffset; PicTop := PicTop + vPicOffset; if ((PicLeft + TextWidth) > ScreenWidth) or ((PicTop + TextHeight) > ScreenHeight) then begin PicLeft := PicLeftBase; PicTop := PicTopBase; end; if (TextTop + TextHeight) > ScreenHeight then TextHeight := ScreenHeight - TextTop - 4; SetRect(wrect, TextLeft, TextTop, TextLeft + TextWidth, TextTop + TextHeight); TextWindowPtr := NewWindow(nil, wrect, name, true, 0, pointer(-1), true, 0); if TextWindowPtr = nil then begin DisposPtr(ptr(TextInfo)); TextInfo := nil; exit(MakeNewTextWindow); end; WindowPeek(TextWindowPtr)^.WindowKind := TextKind; WindowPeek(TextWindowPtr)^.RefCon := LongInt(TextInfo); SetRect(crect, TextWidth - ScrollBarWidth, -1, TextWidth + 1, TextHeight - 14); vTextScrollBar := NewControl(TextWindowPtr, crect, '', true, 0, 0, TextHeight - 14, ScrollBarProc, 0); SetRect(crect, -1, TextHeight - ScrollBarWidth, TextWidth - 14, TextHeight + 1); hTextScrollBar := NewControl(TextWindowPtr, crect, '', true, 0, 0, TextWidth - 14, ScrollBarProc, 0); InitTextEdit; DrawControls(TextWindowPtr); WhatToUndo := NothingToUndo; TextTitle := name; TextRefNum := 0; Changes := false; TooBig := false; InsMenuItem(WindowsMenuH, 'Dummy', WindowsMenuItems - 1 + nTextWindows); SetItem(WindowsMenuH, WindowsMenuItems + nTextWindows, name); nTextWindows := nTextWindows + 1; WindowNum := nTextWindows; TextWindow[nTextWindows] := TextWindowPtr; MakeNewTextWindow := true; end; {with} end; function OpenTextFile (name: str255; RefNum: integer): boolean; var err: OSErr; f, item: integer; TextFileSize: LongInt; LargerThan32K: boolean; begin OpenTextFile := false; if FreeMem < MinFree then begin PutMessage('Not enough memory to open this text file.'); exit(OpenTextFile); end; LargerThan32K := false; err := FSOpen(name, RefNum, f); err := GetEof(f, TextFileSize); if TextFileSize > MaxTextBufSize then begin item := PutMessageWithCancel('This text file is larger than 32K. Would you like to to open the first 32K?'); if item = cancel then begin err := fsclose(f); exit(OpenTextFile); end else begin TextFileSize := 30000; LargerThan32K := true; end; end; if not MakeNewTextWindow(name, 500, 400) then begin err := fsclose(f); exit(OpenTextFile); end; with TextInfo^ do begin SetHandleSize(TextTE^^.hText, TextFileSize); if MemError <> noErr then begin err := fsclose(f); PutMessage('Out of memory.'); DisposePtr(ptr(TextInfo)); TextInfo := nil; exit(OpenTextFile); end; err := SetFPos(f, fsFromStart, 0); ShowWatch; TextTE^^.teLength := TextFileSize; err := fsRead(f, TextFileSize, TextTE^^.hText^); if err <> noErr then begin TextTE^^.teLength := 0; SetHandleSize(TextTE^^.hText, 0); err := fsclose(f); exit(OpenTextFile); end; TECalText(TextTE); TextTitle := name; TextRefNum := RefNum; TooBig := LargerThan32K; end; {with} err := fsclose(f); OpenTextFile := true; end; procedure DoKeyDownInText (ch: char); begin if TextInfo <> nil then begin TEKey(ch, TextInfo^.TextTE); TextInfo^.Changes := true; UpdateScrollBars; {with TextInfo^ do ShowMessage(concat(long2str(TextTE^^.teLength), ' ', long2str(GetHandleSize(TextTE^^.hText))));} WhatToUndo := NothingToUndo; end; end; procedure ChangeFontOrSize; begin if TextInfo <> nil then with TextInfo^ do begin TextTE^^.TxFont := CurrentFontID; SetFontSize; SetPort(TextWindowPtr); EraseRect(TextTE^^.viewRect); TEUpdate(TextTE^^.viewRect, TextTE); UpdateScrollBars; end; {with} end; procedure DoTextCopy; var err: OSErr; begin if TextInfo <> nil then begin TECopy(TextInfo^.TextTE); err := ZeroScrap; if err = NoErr then begin err := TEToScrap; WhatsOnClip := NothingOnClip; {It is on System Scrap} end; end; end; procedure DoTextPaste; var err: OSErr; begin if TextInfo <> nil then begin err := TEFromScrap; if err = NoErr then TEPaste(TextInfo^.TextTE); TextInfo^.Changes := true; UpdateScrollBars; WhatToUndo := NothingToUndo; end; end; procedure DoTextClear; var err: OSErr; begin if TextInfo <> nil then begin TEDelete(TextInfo^.TextTE); TextInfo^.Changes := true; end; UpdateScrollBars; WhatToUndo := NothingToUndo; end; procedure DoSaveText; var err, f: integer; TheInfo: FInfo; ByteCount: LongInt; begin if TextInfo <> nil then with TextInfo^ do begin hlock(handle(TextTE)); with TextTE^^ do begin ByteCount := TELength; if ByteCount = 0 then exit(DoSaveText); err := GetFInfo(TextTitle, TextRefNum, TheInfo); case err of NoErr: if TheInfo.fdType <> 'TEXT' then begin TypeMismatch(TextTitle); exit(DoSaveText) end; FNFerr: begin err := create(TextTitle, TextRefNum, 'Imag', 'TEXT'); if CheckIO(err) <> 0 then exit(DoSaveText); end; otherwise if CheckIO(err) <> 0 then exit(DoSaveText) end; ShowWatch; err := fsopen(TextTitle, TextRefNum, f); if CheckIO(err) <> 0 then exit(DoSaveText); err := fswrite(f, ByteCount, hText^); if CheckIO(err) <> 0 then exit(DoSaveText); err := SetEof(f, ByteCount); err := fsclose(f); err := FlushVol(nil, TextRefNum); Changes := false; end; {with} hunlock(handle(TextTE)); end; {with} end; procedure SaveTextAs; var where: Point; reply: SFReply; begin if TextInfo <> nil then begin where.v := 60; where.h := 100; SFPutFile(where, 'Save Text as?', TextInfo^.TextTitle, nil, reply); if reply.good then with reply, TextInfo^ do begin TextTitle := fname; TextRefNum := vRefNum; DoSaveText; SetWTitle(TextWindowPtr, TextTitle); SetItem(WindowsMenuH, WindowsMenuItems - 1 + WindowNum, TextTitle); end; end; end; procedure SaveText; begin if TextInfo <> nil then begin with TextInfo^ do if (TextRefNum = 0) or TooBig then SaveTextAs else DoSaveText; end; end; function SaveTextChanges: integer; const yesID = 1; NoID = 2; CancelID = 3; var id: integer; reply: SFReply; begin id := 0; with TextInfo^ do if changes and not TooBig then begin if macro and (MacroCommand = DisposeC) then begin SaveTextChanges := ok; exit(SaveTextChanges); end; ParamText(TextTitle, '', '', ''); InitCursor; id := alert(600, nil); if id = yesID then SaveText; end; {if changes} if id = cancelID then SaveTextChanges := cancel else SaveTextChanges := ok; end; procedure InsertText (str: str255; EndOfLine: boolean); var i: integer; begin if TextInfo <> nil then with TextInfo^ do begin if EndOfLine then str := concat(str, cr); for i := 1 to length(str) do TEKey(str[i], TextTE); Changes := true; UpdateScrollBars; WhatToUndo := NothingToUndo; end; end; procedure GoToLine (str: str255; data: CharArrayPtr); var pos, line: integer; found: boolean; n: LongInt; begin with TextInfo^.TextTE^^ do begin found := false; delete(str, 1, 1); StringToNum(str, n); pos := 0; line := 1; if n = 1 then found := true else repeat if data^[pos] = cr then line := line + 1; pos := pos + 1; if line = n then begin found := true; leave; end; until (pos >= teLength); if found then begin TESetSelect(pos, pos, TextInfo^.TextTE); TEKey('x', TextInfo^.TextTE); TEKey(BackSpace, TextInfo^.TextTE); UpdateScrollBars; end else beep; end; end; procedure DoFind; const StringID = 3; var mylog: DialogPtr; item: integer; i, firstpos, lastpos, pos: integer; slength: integer; match: boolean; data: CharArrayPtr; c: char; str: str255; begin if TextInfo = nil then exit(DoFind); hlock(handle(TextInfo^.TextTE)); with TextInfo^.TextTE^^ do begin if not OptionKeyWasDown then begin InitCursor; ParamText('What would you like to find?', '', '', ''); mylog := GetNewDialog(170, nil, pointer(-1)); SetDString(MyLog, StringID, SearchString); SelIText(MyLog, StringID, 0, 32767); OutlineButton(MyLog, ok, 16); repeat ModalDialog(nil, item); until (item = ok) or (item = cancel); if item = cancel then begin DisposDialog(mylog); exit(DoFind) end; SearchString := GetDString(MyLog, StringID); DisposDialog(mylog); end; slength := Length(SearchString); if slength = 0 then exit(DoFind); str := SearchString; MakeLowerCase(str); data := CharArrayPtr(htext^); if (slength > 1) and (str[1] = '#') and (str[2] >= '0') and (str[2] <= '9') then begin GoToLine(str, data); hunlock(handle(TextInfo^.TextTE)); exit(DoFind); end; match := false; lastpos := teLength - slength - 1; match := false; for firstpos := selEnd to lastpos do begin match := true; for i := 1 to slength do begin c := data^[firstpos + i - 1]; if (c >= 'A') and (c <= 'Z') then c := chr(ord(c) + 32); if c <> str[i] then begin match := false; leave end; end; if match then begin pos := firstpos; leave; end; end; if match then begin TESetSelect(pos, pos, TextInfo^.TextTE); TEKey('x', TextInfo^.TextTE); TEKey(BackSpace, TextInfo^.TextTE); TESetSelect(pos, pos + slength, TextInfo^.TextTE); UpdateScrollBars; end else beep; end; {with} hunlock(handle(TextInfo^.TextTE)); end; end.